
package Sgdb::Cntr::Controler ;

use Sgdb::Utils qw (:DEFAULT
                    tracepoints_list
                    ) ;
# pragmas for all
use warnings ;
use strict ;
use integer ;
use bytes ;

use integer ;
use bytes ;

our $auto_trace_algo = '2_tracepoints_per_branch' ;
our $trace_range    = 'partial' ;

our $major_minor;
our $patchname ;

init () ;

sub init {

    hook_add ('trace-function-coverage'        => [\&trace_function, 'function_coverage'] ,
              'trace-function-debug'           => [\&trace_function, 'function_debug' ] ,
              'trace-function-debug-locals'    => [\&trace_function, 'function_debug_locals' ] ,
              ) ;
    1 ;
}

sub new {

    return telthemloud "Error: $@" unless require Sgdb::Cntr::ControlerExt ;

    &Ext_new ;
}

sub trace_function {

    return telthemloud "gdb is not alive. Pls activate" unless gdb_cached 'is-alive' ;

    my $type = shift ;
    my $addr = shift or return telme 'no addr' ;
    my $add2 = shift ;
    my $func ;
    if (  $add2 ) {
        ( $addr ) = gdb_exec_quiet ("info line $addr") =~ /(0x[\da-f]+)/i ;
        ( $add2 ) = gdb_exec_quiet ("info line $add2") =~ /(0x[\da-f]+)/i ;
        ( $func ) = "$addr $add2" if $addr and $add2 ;
    }
    else {
        ( $func ) = gdb_exec_quiet ("info line $addr" ) =~ /\<(\w+)/;
    }

    return telthem "unknow sources in this line" unless $func ;

    trace ( $type, auto_trace ($type , gdb_exec_quiet "disassemble $func" ) ) ;

}


sub auto_trace {

    my $type = shift ;

    my $arch = gdb_exec_quiet 'show architecture' ;

    if    ($type eq 'function_coverage')     {gdb_exec ( 'set emc one_pass_for_each_tdp on'  )}
    elsif ($type eq 'function_debug')        {gdb_exec ( 'set emc one_pass_for_each_tdp off' )}
    elsif ($type eq 'function_debug_locals') {gdb_exec ( 'set emc one_pass_for_each_tdp off' )}
    else                        { die "maze $type "}

    if    ( ! $arch ) {

        return telthemloud "can't determine architecture" ;
    }
    elsif ( $arch =~ /m68/ ) {

        return telthemloud "Internal Error: $@" unless require Sgdb::Cntr::CoverageM68 ;

        return Sgdb::Cntr::CoverageM68::function_coverage     ( $auto_trace_algo, @_ ) if $type eq 'function_coverage'     ;
        return Sgdb::Cntr::CoverageM68::function_debug        ( $auto_trace_algo, @_ ) if $type eq 'function_debug'        ;
        return Sgdb::Cntr::CoverageM68::function_debug_locals ( $auto_trace_algo, @_ ) if $type eq 'function_debug_locals' ;
        die "maze $type"
    }
    elsif ( $arch =~ /powerpc/ ) {

        return telthemloud "Internal Error: $@" unless require Sgdb::Cntr::CoveragePPC ;

        return Sgdb::Cntr::CoveragePPC::function_coverage     ( $auto_trace_algo, @_ ) if $type eq 'function_coverage'     ;
        return Sgdb::Cntr::CoveragePPC::function_debug        ( $auto_trace_algo, @_ ) if $type eq 'function_debug'        ;
        return Sgdb::Cntr::CoveragePPC::function_debug_locals ( $auto_trace_algo, @_ ) if $type eq 'function_debug_locals' ;
        die "maze $type" ;
    }
    elsif ( $arch =~ /i386/ ) {

        return telthemloud "Internal Error: $@" unless require Sgdb::Cntr::CoverageI386 ;

        return Sgdb::Cntr::CoverageI386::function_coverage     ( $auto_trace_algo, @_ ) if $type eq 'function_coverage'     ;
        return Sgdb::Cntr::CoverageI386::function_debug        ( $auto_trace_algo, @_ ) if $type eq 'function_debug'        ;
        return Sgdb::Cntr::CoverageI386::function_debug_locals ( $auto_trace_algo, @_ ) if $type eq 'function_debug_locals' ;
        die "maze $type" ;
    }
    else {

        telthemloud "Unknown architecture: $arch" ;
    }
}

sub trace {
    return telthemloud "gdb is not alive. Use Activate button to activate gdb" unless gdb_cached 'is-alive' ;

    my $last_addr= 0 ;
    my $type = shift;
    my @tracepoints;
#      my @tracepoints =  ( sort
#                           @_,
#                           map { hex }
#                           map {  /^\d+\s+y.*(0x[\da-f]+)/ }
#                           tracepoints_list
#                           ) ;

    if ($type eq 'function_coverage') {

        @tracepoints =  ( sort
                             @_,
                             map { hex }
                             map {  /^\d+\s+y.*(0x[\da-f]+)/ }
                             tracepoints_list
                             ) ;


#        gdb_exec "delete tracepoints" ;
    }

    else {
        @tracepoints =  ( sort @_);
    }

#    telme "\n@_\n","@tracepoints\n";

    foreach my $trace ( @tracepoints ) {

        my ($addr, @actions ) = split ':', $trace ;

        next if $addr eq $last_addr ;

        $last_addr = $addr ;

        gdb_exec_quiet "trace *$addr" ;

        if (@actions) {

            for my $cmd ( 'actions',
                          @actions,
                          'end',
                          'end',
                         ) { gdb_exec_quiet $cmd }
        }
     }

    hook_run 'show-data-tracepoints' ;
    hook_run 'refresh-breakpoints' ;
}

